PC-SIG Library 8

home *** CD-ROM | disk | FTP | other *** search

/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0214 / cfile.bas < prev next >

Wrap

BASIC Source File | 1983-03-10 | 18.5 KB | 636 lines

4 DEFINT A-W,Y-Z 5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40) 13 DIM L(17),NREC(17) 16 DIM KY(17,40),KEYLIST(17,40) 35 DIM K$(80) 40 DIM SCRN(40),MFLG(40) 45 DIM REALFLG(40) 70 CH = 29 75 PRINT FRE(0) 80 GOSUB 52000 100 GOSUB 50000 200 GOTO 40000 500 REM ******* CLS 510 CLS 520 RETURN 8000 REM ***** FILE NAME ACCEPLABLE TEST ************ 8010 TEST = 1 8100 FOR Q = 1 TO LEN(A$) 8110 K$(Q) = MID$(A$,Q,1) 8120 C = ASC(K$(Q)) 8130 IF C < 48 OR C > 122 THEN TEST = 4 8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4 8150 NEXT Q 8190 RETURN 23780 REM ************* READ SUBROUTINE ************* 23800 OPEN "I",#1,"FFILE" 23820 INPUT #1,MAXF 23840 FOR A = 1 TO MAXF 23860 INPUT #1,A,F$(A),NREC(A),L(A) 23880 FOR N = 1 TO NREC(A) 23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N) 23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N) 23940 NEXT N 23960 NEXT A 23980 CLOSE #1 24000 RETURN 25000 REM ************ WRITE SCREEN TEST ********* 25100 OPEN "O",#1,"SCTEST" 25200 FOR T = 1 TO 40 25300 WRITE #1,SCRN(T) 25400 NEXT T 25500 CLOSE #1 25600 RETURN 26000 REM ************ READ SCREEN TEST ********* 26100 OPEN "I",#1,"SCTEST" 26200 FOR T = 1 TO 40 26300 INPUT #1,SCRN(T) 26400 NEXT T 26500 CLOSE #1 26600 RETURN 27000 REM ********** READ IDEX SUBROUTINE 27010 OPEN "I",#1,"IDEX" 27020 FOR T = 1 TO MAXF 27030 INPUT #1,D,D,D,MFLG(T) 27040 NEXT T 27050 CLOSE #1 27060 RETURN 27070 REM ********** WRITE IDEX SUBROUTINE 27080 OPEN "O",#1,"IDEX" 27090 FOR T = 1 TO 30 27100 WRITE #1,D,D,D,MFLG(T) 27110 NEXT T 27120 CLOSE #1 27130 RETURN 40000 REM ******* FILE DESCRIPTION MENU ********* 40060 GOSUB 500 40080 PRINT "**************** FILE DESCRIPTION MENU ******************" 40100 PRINT "" 40120 PRINT " 0 - EXIT TO OPERATING SYSTEM" 40125 PRINT "" 40140 PRINT " 1 - ENTER A FILE DESCRIPTION" 40145 PRINT "" 40160 PRINT " 2 - READ A SINGLE FILE DESCRIPTION" 40165 PRINT "" 40180 PRINT " 3 - READ ALL FILE DESCRIPTIONS" 40185 PRINT "" 40200 PRINT " 4 - PRINT ON PAPER ONE FILE DESCRIPTION " 40205 PRINT "" 40220 PRINT " 5 - PRINT ON PAPER ALL THE FILE DESCRIPTIONS" 40240 PRINT "" 40260 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ************" 40280 GOSUB 60000 40282 IF DT# <0 OR DT# >5 GOTO 40280 40300 T = DT# 40310 IF T = 0 THEN 51000 40320 ON T GOTO 40620,40340,40540,40740,40960 40340 GOSUB 500 40360 PRINT "************ WHAT FILE DESCRIPTION DO YOU WANT TO READ **********" 40380 FOR T = 1 TO MAXF 40400 PRINT T;"-";F$(T) 40420 NEXT T 40440 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN **************" 40460 GOSUB 60000 40462 IF DT# <1 OR DT# >MAXF GOTO 40460 40480 A = DT# 40500 GOSUB 42680 40520 GOTO 40060 40540 FOR A = 1 TO MAXF 40560 GOSUB 42680 40580 NEXT A 40600 GOTO 40060 40620 GOSUB 41040 40640 GOSUB 45020 40660 GOSUB 42580 40680 GOSUB 43220 40700 GOSUB 44420 40720 GOTO 40060 40740 REM PRINT A SINGLE RECORD 40760 GOSUB 500 40780 PRINT "************ WHAT FILE DESCRIPTION DO YOU WANT PRINTED **********" 40800 FOR T = 1 TO MAXF 40820 PRINT T;"-";F$(T) 40840 NEXT T 40860 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN **************" 40880 GOSUB 60000 40882 IF DT# <1 OR DT# >MAXF GOTO 40880 40900 A = DT# 40920 GOSUB 43700 40940 GOTO 40060 40960 FOR A = 1 TO MAXF 40980 GOSUB 43700 41000 NEXT A 41020 GOTO 40060 41040 GOSUB 500 41060 PRINT "**************** NEW FILE DESCRIPTION ENTRY ******************" 41080 FOR T = 1 TO MAXF 41100 PRINT T;"-";F$(T) 41120 NEXT T 41140 T1 = MAXF + 1 41160 PRINT "***** YOU MAY RENAME AND REDEFINE ANY OF THE ABOVE FILES ***** 41180 PRINT " ---- YOU WILL LOSE ALL STORED DATA IN A FILE YOU REDEFINE ---" 41200 PRINT " OR " 41220 PRINT "------- YOU MAY ENTER A NEW FILE WITH FILE NUMBER = ";T1;"------" 41240 PRINT "" 41260 PRINT "*********** ENTER THE FILE NUMBER THEN PRESS RETURN ***********" 41280 PRINT "" 41300 GOSUB 60000 41302 IF DT# <1 OR DT# >T1 GOTO 41300 41320 A = DT# 41340 GOTO 44200 41360 PRINT "***** ENTER THE FILE NAME -- 8 CHARACTERS OR LESS *****" 41380 PRINT "--------- LETTERS AND NUMBERS ONLY , NO SPACES --------" 41400 PRINT "----------- FIRST CHARACTER MUST BE A LETTER ----------" 41420 MAX = 8 41440 GOSUB 62030 41450 GOSUB 8000 41455 IF TEST = 4 GOTO 41440 41460 F$(A) = A$ 41480 PRINT "******** ENTER THE NUMBER OF FIELDS IN THIS FILE *******" 41500 GOSUB 60000 41502 IF DT# <1 OR DT# >100 GOTO 41500 41520 NREC(A) = DT# 41540 FOR N = 1 TO NREC(A) 41560 GOSUB 41620 41580 NEXT N 41600 RETURN 41620 GOSUB 500 41640 PRINT "FIELD NUMBER ";N 41660 PRINT "******** ENTER THE NAME OF THIS FIELD **********" 41680 MAX = 20 41700 GOSUB 62030 41720 FLDN$(A,N) = A$ 41740 PRINT "*************** IS THIS FILELD *****************" 41760 PRINT " 1 - A NUMBER " 41780 PRINT " 2 - A STRING " 41800 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******" 41820 GOSUB 60000 41822 IF DT# <1 OR DT# >2 GOTO 41820 41840 T = DT# 41860 ON T GOTO 41880,42420 41880 REM 41900 PRINT "****************** IS THIS NUMBER AN *******************" 41920 PRINT " 1 - INTEGER " 41930 PRINT " ---- MAY BE DECLARE A KEY TO A LIST 41940 PRINT " ---- NO DECIMALS, A NUMBER FROM -32,768 TO +32,768" 41960 PRINT " 2 - SINGLE PRECISION" 41980 PRINT " ---- DECIMALS ALLOWED, ONLY SIX DIGITS ACCURACY" 42000 PRINT " 3 - DOUBLE PRECISION" 42020 PRINT " ---- DECIMALS ALLOWED, 15 DIGITS ACCURACY" 42040 PRINT " 4 - DOLLARS AND CENTS " 42060 PRINT " ---- USE FOR ALL DOLLAR AND CENTS AMOUNTS " 42080 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN **********" 42100 GOSUB 60000 42102 IF DT# <1 OR DT# >4 GOTO 42100 42120 T = DT# 42140 ON T GOTO 42160,42240,42300,42360 42160 FTY(A,N) = 2 42180 FL(A,N) = 2 42200 GOSUB 44720 42220 GOTO 42560 42240 FTY(A,N) = 3 42260 FL(A,N) = 4 42280 GOTO 42560 42300 FTY(A,N) = 4 42320 FL(A,N) = 8 42340 GOTO 42560 42360 FTY(A,N) = 5 42380 FL(A,N) = 8 42400 GOTO 42560 42420 FTY(A,N) = 1 42440 PRINT "************ WHAT IS THE MAXIMUM LENGTH OF THE STRING **********" 42460 PRINT " ----- ENTER A NUMBER FROM 1 TO 55 ----- 42480 PRINT "*************** ENTER THE LENGTH THEN PRESS RETURN *************" 42500 GOSUB 60000 42502 IF DT# <1 OR DT# >55 GOTO 42500 42520 FL(A,N) = DT# 42560 RETURN 42580 L(A) = 0 42600 FOR N = 1 TO NREC(A) 42620 L(A) = L(A) + FL(A,N) 42640 NEXT N 42660 RETURN 42680 GOSUB 500 42690 GOSUB 42580 42700 PRINT "-------------------------------------------------------------------------------" 42720 PRINT "FILE NUMBER : ";A 42740 PRINT "FILE NAME : "; F$(A) 42760 PRINT "NUMBER OF FIELDS : ";NREC(A) 42780 PRINT "RECORD LENGTH : ";L(A) 42800 FOR N = 1 TO NREC(A) 42820 PRINT N ;TAB(5);FLDN$(A,N); 42840 ON FTY(A,N) GOTO 42860,42900,42980,43020,43060 42860 PRINT TAB(30) " STRING WITH MAXIMUM LENGTH ";FL(A,N) 42880 GOTO 43080 42900 PRINT TAB(30) " INTEGER "; 42920 IF KY(A,N) = 2 THEN PRINT "--- KEY FOR LIST # ";KEYLIST(A,N) 42940 IF KY(A,N) <> 2 THEN PRINT "" 42960 GOTO 43080 42980 PRINT TAB(30) " SINGLE PRECISION " 43000 GOTO 43080 43020 PRINT TAB(30) " DOUBLE PRECISION " 43040 GOTO 43080 43060 PRINT TAB(30) " DOLLARS AND CENTS " 43080 REM *** 43100 NEXT N 43120 PRINT "-------------------------------------------------------------------------------" 43140 PRINT "*************** PRESS ANY KEY TO CONTINUE ******************" 43160 PRINT "" 43180 IF INKEY$ = "" GOTO 43180 43200 RETURN 43220 REM ****** STORE FILES OM FILE FILE ****** 43240 OPEN "O",#1,"FFILE" 43260 WRITE #1,MAXF 43280 FOR T = 1 TO MAXF 43300 WRITE #1,T,F$(T),NREC(T),L(T) 43320 FOR N = 1 TO NREC(T) 43340 WRITE #1,FLDN$(T,N),FTY(T,N),FL(T,N) 43360 IF FTY(T,N) = 2 THEN WRITE #1,KY(T,N),KEYLIST(T,N) 43380 NEXT N 43400 NEXT T 43420 CLOSE #1 43425 GOSUB 26000 43430 SCRN(A) = 0 43432 GOSUB 25000 43434 GOSUB 27000 43436 MFLG(A) = 0 43438 GOSUB 27070 43439 GOSUB 53000 43440 RETURN 43700 LPRINT "-------------------------------------------------------------------------------" 43720 LPRINT "FILE NUMBER : ";A 43740 LPRINT "FILE NAME : "; F$(A) 43760 LPRINT "NUMBER OF FIELDS : ";NREC(A) 43780 LPRINT "RECORD LENGTH : ";L(A) 43800 FOR N = 1 TO NREC(A) 43820 LPRINT N ;TAB(5);FLDN$(A,N); 43840 ON FTY(A,N) GOTO 43860,43900,43980,44020,44060 43860 LPRINT TAB(30) " STRING WITH MAXIMUM LENGTH ";FL(A,N) 43880 GOTO 44080 43900 LPRINT TAB(30) " INTEGER "; 43920 IF KY(A,N) = 2 THEN LPRINT "--- KEY FOR LIST # ";KEYLIST(A,N) 43940 IF KY(A,N) <> 2 THEN LPRINT "" 43960 GOTO 44080 43980 LPRINT TAB(30) " SINGLE PRECISION " 44000 GOTO 44080 44020 LPRINT TAB(30) " DOUBLE PRECISION " 44040 GOTO 44080 44060 LPRINT TAB(30) " DOLLAR AND CENTS AMOUNT " 44080 REM *** 44100 NEXT N 44120 PRINT "" 44140 RETURN 44160 END 44180 REM ************ CHECK FOR SKIPED FILES *************** 44200 IF A > MAXF+1 GOTO 44280 44220 IF A > MAXF THEN MAXF = A 44240 GOTO 41360 44260 PRINT "" 44280 PRINT "" 44300 PRINT "+++++++++++++++ MISTAKE ++++++++++++++++ 44320 PRINT " YOU MAY NOT SKIP FILE NUMBERS" 44340 PRINT "THE HIGEST NUMBER FILE IS CURRENTLY ";MAXF 44360 PRINT "YOU MAY NUMBER YOUR FILE FROM 1 TO ";MAXF+1 44380 PRINT "" 44400 GOTO 41180 44420 REM ****** OPEN INITAL IPUT DATA FILE ****** 44440 GOSUB 500 44460 PRINT "******** PUTING DATA ON INPUT DATA FILE ********" 44480 PRINT A 44500 T$ = STR$(A) 44520 T$ = MID$(T$,2) 44540 N$ = "IPUTD" + T$ 44560 PRINT N$ 44580 OPEN "O",#2,N$ 44600 WRITE #2,NREC(A) 44620 FOR T = 1 TO NREC(A) 44640 WRITE #2,1," " 44660 NEXT T 44680 CLOSE #2 44700 RETURN 44720 REM ******** KEYLIST PROGRAM *********** 44740 GOSUB 500 44760 PRINT "FILE :";F$(A);" FIELD : ";N;"- ";FLDN$(A,N) 44780 PRINT "" 44800 PRINT "************ IS THIS FIELD A KEY TO A LIST ***********" 44820 PRINT "" 44840 PRINT " 1 - NOT A KEY " 44860 PRINT " 2 - IS A KEY " 44880 PRINT "" 44900 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********" 44910 GOSUB 60000 44912 IF DT# <1 OR DT# >2 GOTO 44910 44920 KY(A,N) = DT# 44940 IF KY(A,N) = 1 THEN RETURN 44960 PRINT "********* WHAT KEY LIST DOES THIS FIELD ACCESS ********" 44970 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********" 44980 GOSUB 60000 44982 IF DT# <1 OR DT# >10 GOTO 44980 44990 KEYLIST(A,N) = DT# 45000 RETURN 45020 REM ************ CHANGE ********** 45040 GOSUB 42680 45080 PRINT "********** WHAT FIELD DO YOU WANT TO CHANGE ************" 45120 PRINT "*************** ENTER 0 FOR NO CHANGES *****************" 45140 GOSUB 60000 45142 IF DT# <0 OR DT# >NREC(A) GOTO 45140 45150 N = DT# 45160 IF N = 0 THEN RETURN 45180 GOSUB 41620 45200 GOTO 45020 50000 REM ********** INTRO 50010 GOSUB 500 50100 PRINT " F I L E D E S C R I P T I O N P R O G R A M 2.0 " 50105 PRINT "" 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc." 50120 PRINT "" 50130 PRINT "This program is licensed FREE to all users with some restrictions" 50165 PRINT " See the manual for more information on the license." 50167 PRINT "" 50920 GOSUB 23780 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *****************"; 50960 IF INKEY$ = "" GOTO 50960 50970 RETURN 51000 REM ***** EXIT TO SYSTEM 51100 GOSUB 500 51110 CLOSE 51120 PRINT " -BYE, Have a nice day" 51130 END 52000 REM ***** INTRO 1 52010 GOSUB 500 52100 PRINT " Put the DATA DISK in the default disk drive " 52110 PRINT "" 52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****" 52130 PRINT "" 52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK" 52150 PRINT "Keep it in the default disk drive at all times during this program." 52200 IF INKEY$ = "" GOTO 52200 52210 RETURN 53000 REM ********** READ IDEX SUBROUTINE 53010 OPEN "I",#1,"REALTIME" 53020 FOR T = 1 TO MAXF 53030 INPUT #1,REALFLG(T) 53040 NEXT T 53050 CLOSE #1 53060 REALFLG(A) = 0 53070 REM ********** WRITE IDEX SUBROUTINE 53080 OPEN "O",#1,"REALTIME" 53090 FOR T = 1 TO 30 53100 WRITE #1,REALFLG(T) 53110 NEXT T 53120 CLOSE #1 53130 RETURN 60000 REM ******* INTEGER LESS THEN 100 CHECK ******** 60010 MAX = 2 60020 ACT$ = "1234567890=<>^" 60030 IF NE = 0 THEN ACT$ = "1234567890" 60040 PRINT ">__<"; 60050 GOTO 60240 60060 REM ******* INTEGER ******* 60070 MAX = 8 60080 ACT$ = "1234567890-+,=<>^" 60090 IF NE = 0 THEN ACT$ = "1234567890-+," 60100 PRINT ">________<"; 60110 GOTO 60240 60120 REM ******* SINGLE PRECISION ******* 60130 MAX = 10 60140 ACT$ = "1234567890-+,.%$=<>^" 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60160 PRINT ">__________<"; 60170 GOTO 60240 60180 REM ******* DOUBLE PRECISION ******* 60190 MAX = 20 60200 ACT$ = "1234567890-+,.%$=<>^" 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60220 PRINT ">____________________<"; 60230 GOTO 60240 60240 REM ********** NUMBER CHECK ********** 60250 A$ = "" 60260 K$(20) = " " 60270 KTMAX = 0 60280 FOR T9 = 1 TO MAX 60290 K$(T9) = " " 60300 NEXT T9 60310 DIG$ = "1234567890." 60320 DOTFLG = 0 60330 T2 = MAX + 1 60340 FOR T6 = 1 TO T2 60350 PRINT CHR$(CH); 60360 NEXT T6 60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370 60380 KT = 0 60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 60400 KT = KT + 1 60410 REM 60420 W$ = INKEY$ 60430 IF W$ = "" GOTO 60420 60440 C = ASC(W$) 60450 IF C = 0 THEN GOSUB 61900 60460 IF C = 13 GOTO 60580 60470 IF C = 17 OR C = 8 GOTO 61150 60480 IF C = 19 GOTO 60670 60490 IF C = 4 GOTO 60720 60500 IF C = 6 GOTO 60780 60510 IF C = 1 GOTO 60960 60520 IF KT > MAX GOTO 60410 60530 IF INSTR(ACT$,W$) = 0 GOTO 61230 60540 K$(KT) = W$ 60550 PRINT K$(KT); 60560 IF KT > KTMAX THEN KTMAX = KT 60570 GOTO 60400 60580 REM ********** RETURN ********** 60590 FOR T9 = 1 TO KTMAX 60600 A$ = A$ + K$(T9) 60610 NEXT T9 60620 IF KTMAX = 0 THEN PRINT "1" 60630 IF KTMAX = 0 THEN DT# = 1 60640 IF KTMAX = 0 THEN RETURN 60650 PRINT "" 60660 GOTO 61260 60670 REM ********* MOVE CURSE BACK ******** 60680 IF KT = 1 GOTO 60410 60690 KT = KT - 1 60700 PRINT CHR$(CH); 60710 GOTO 60410 60720 REM ********* MOVE CURSER FORWARD ********* 60730 IF KT >= MAX GOTO 60410 60740 IF KT > (KTMAX + 1) GOTO 60410 60750 PRINT K$(KT); 60760 KT = KT + 1 60770 GOTO 60410 60780 REM ********** INSERT *********** 60790 IF KT > KTMAX GOTO 60410 60800 X9 = MAX 60810 WHILE X9 > KT 60820 X9 = X9 - 1 60830 K$(X9 + 1) = K$(X9) 60840 WEND 60850 K$(KT) = " " 60860 KTMAX = KTMAX + 1 60870 IF KTMAX > MAX THEN KTMAX = MAX 60880 FOR T9 = KT TO KTMAX 60890 PRINT K$(T9); 60900 NEXT T9 60910 T6 = (KTMAX - KT) + 1 60920 FOR T7 = 1 TO T6 60930 PRINT CHR$(CH); 60940 NEXT T7 60950 GOTO 60410 60960 REM ********** DELETE *********** 60970 IF KT > KTMAX GOTO 60410 60980 IF KTMAX = 1 GOTO 60410 60990 K$(MAX + 1) = "" 61000 X9 = KT 61010 WHILE X9 <= MAX 61020 K$(X9) = K$(X9 + 1) 61030 X9 = X9 + 1 61040 WEND 61050 KTMAX = KTMAX - 1 61060 FOR T9 = KT TO KTMAX 61070 PRINT K$(T9); 61080 NEXT T9 61090 PRINT "_"; 61100 T7 = (KTMAX - KT) + 2 61110 FOR T8 = 1 TO T7 61120 PRINT CHR$(CH); 61130 NEXT T8 61140 GOTO 60410 61150 REM ********* BACKSPACE ******** 61160 IF KT = 1 GOTO 60410 61170 KT = KT - 1 61180 PRINT CHR$(CH); 61190 K$(KT) = " " 61200 PRINT "_"; 61210 PRINT CHR$(CH); 61220 GOTO 60410 61230 REM ******* INPUT NOT ACCEPTABLE ******** 61240 PRINT CHR$(7); 61250 GOTO 60420 61260 REM ********* CLEAR STRINGS ******** 61270 MAX = LEN(A$) 61280 D2$ = "" 61290 D1$ = "" 61300 DFLG = 0 61310 FOR Q93 = 1 TO MAX 61320 R$ = MID$(A$,Q93,1) 61330 IF INSTR(DIG$,R$) = 0 GOTO 61400 61340 IF R$ = "." OR DFLG = 1 GOTO 61380 61350 IF DFLG = 1 GOTO 61380 61360 D2$ = D2$ + R$ 61370 GOTO 61400 61380 D1$ = D1$ + R$ 61390 DFLG = 1 61400 NEXT Q93 61410 DA# = VAL(D2$) 61420 D1# = VAL(D1$) 61430 DT# = DA# + D1# 61440 IF K$(1) = "-" THEN DT# = -DT# 61450 RETURN 61900 REM ****** CHECK FOR ASC0 61910 S4$ = INKEY$ 61920 C2 = ASC(S4$) 61930 IF C2 = 83 THEN C = 1 61940 IF C2 = 82 THEN C = 6 61950 IF C2 = 75 THEN C = 19 61960 IF C2 = 77 THEN C = 4 61970 RETURN 62000 REM ********** ALPHANUMERIC CHECK ************** 62010 MAX = FL(A,Q) 62020 GOTO 62040 62030 REM ******** MAX SET IN PROGRAM ******** 62040 A$ = "" 62050 PRINT ">"; 62060 FOR N9 = 1 TO MAX 62070 K$(N9) = "" 62080 PRINT "_"; 62090 NEXT N9 62100 PRINT "<"; 62110 T2 = MAX + 1 62120 FOR T4 = 1 TO T2 62130 PRINT CHR$(CH); 62140 NEXT T4 62150 KT = 0 62160 KTMAX = 1 62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 62180 KT = KT + 1 62190 PRINT TAB(KT+1)""; 62200 K$ = INKEY$ 62210 IF K$ = "" GOTO 62200 62220 C = ASC(K$) 62230 IF C = 0 THEN GOSUB 61900 62240 IF C = 13 GOTO 62350 62250 IF C = 17 OR C = 8 GOTO 62920 62260 IF C = 19 GOTO 62450 62270 IF C = 4 GOTO 62500 62280 IF C = 6 GOTO 62560 62290 IF C = 1 GOTO 62730 62300 IF KT > MAX GOTO 62190 62310 K$(KT) = K$ 62320 PRINT K$(KT); 62330 IF KT > KTMAX THEN KTMAX = KT 62340 GOTO 62180 62350 REM ********** RETURN ********** 62360 FOR T9 = 1 TO MAX 62370 A$ = A$ + K$(T9) 62420 NEXT T9 62430 PRINT "" 62440 RETURN 62450 REM ********* MOVE CURSE BACK ******** 62460 IF KT = 1 GOTO 62190 62470 KT = KT - 1 62480 PRINT CHR$(CH); 62490 GOTO 62190 62500 REM ********* MOVE CURSER FORWARD ********* 62510 IF KT >= MAX GOTO 62190 62520 IF KT > KTMAX GOTO 62190 62530 PRINT K$(KT); 62540 KT = KT + 1 62550 GOTO 62190 62560 REM ********** INSERT *********** 62570 X9 = MAX 62580 WHILE X9 > KT 62590 X9 = X9 - 1 62600 K$(X9 + 1) = K$(X9) 62610 WEND 62620 K$(KT) = " " 62630 KTMAX = KTMAX + 1 62640 IF KTMAX > MAX THEN KTMAX = MAX 62650 FOR T9 = KT TO KTMAX 62660 PRINT K$(T9); 62670 NEXT T9 62680 T6 = (KTMAX - KT) +1 62690 FOR T7 = 1 TO T6 62700 PRINT CHR$(CH); 62710 NEXT T7 62720 GOTO 62190 62730 REM ********** DELETE *********** 62740 IF KT > KTMAX GOTO 62200 62750 IF KTMAX = 1 GOTO 62190 62760 K$(MAX + 1) = "" 62770 X9 = KT 62780 WHILE X9 <= KTMAX 62790 K$(X9) = K$(X9 + 1) 62800 X9 = X9 + 1 62810 WEND 62820 KTMAX = KTMAX - 1 62830 FOR T9 = KT TO KTMAX 62840 PRINT K$(T9); 62850 NEXT T9 62860 PRINT "_"; 62870 T7 = (KTMAX - KT) + 2 62880 FOR T6 = 1 TO T7 62890 PRINT CHR$(CH); 62900 NEXT T6 62910 GOTO 62190 62920 REM ********* BACKSPACE ******** 62930 IF KT = 1 GOTO 62190 62940 K$(KT) = " " 62950 KT = KT - 1 62960 K$(KT) = " " 62970 PRINT CHR$(CH); 62980 PRINT "_"; 62990 PRINT CHR$(CH); 63000 GOTO 62190 " " 62950 KT = KT - 1 62960 K$(KT) = " "